home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dt01 / dt01.frm < prev    next >
Text File  |  1995-09-06  |  16KB  |  461 lines
  1. VERSION 2.00
  2. Begin Form frmCalendar 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   0  'None
  6.    ClientHeight    =   1020
  7.    ClientLeft      =   1335
  8.    ClientTop       =   1710
  9.    ClientWidth     =   1950
  10.    ForeColor       =   &H00000000&
  11.    Height          =   1425
  12.    Left            =   1275
  13.    ScaleHeight     =   1020
  14.    ScaleWidth      =   1950
  15.    Top             =   1365
  16.    Width           =   2070
  17.    Begin PictureBox gpMonthSpin 
  18.       BackColor       =   &H00C0C0C0&
  19.       Height          =   252
  20.       Index           =   2
  21.       Left            =   1320
  22.       ScaleHeight     =   225
  23.       ScaleWidth      =   270
  24.       TabIndex        =   2
  25.       Top             =   120
  26.       Width           =   300
  27.    End
  28.    Begin PictureBox gpMonthSpin 
  29.       BackColor       =   &H00C0C0C0&
  30.       Height          =   252
  31.       Index           =   1
  32.       Left            =   360
  33.       ScaleHeight     =   225
  34.       ScaleWidth      =   270
  35.       TabIndex        =   3
  36.       Top             =   120
  37.       Width           =   300
  38.    End
  39.    Begin PictureBox pic 
  40.       AutoRedraw      =   -1  'True
  41.       BackColor       =   &H00C0C0C0&
  42.       BorderStyle     =   0  'None
  43.       FontTransparent =   0   'False
  44.       ForeColor       =   &H00000000&
  45.       Height          =   372
  46.       Left            =   480
  47.       ScaleHeight     =   375
  48.       ScaleWidth      =   375
  49.       TabIndex        =   0
  50.       Top             =   480
  51.       Width           =   372
  52.    End
  53.    Begin Timer TmrMonthSpin 
  54.       Enabled         =   0   'False
  55.       Interval        =   200
  56.       Left            =   1320
  57.       Top             =   480
  58.    End
  59.    Begin Label lblMonthText 
  60.       Alignment       =   2  'Center
  61.       BackColor       =   &H00C0C0C0&
  62.       Caption         =   "lMonth"
  63.       Height          =   192
  64.       Left            =   720
  65.       TabIndex        =   1
  66.       Top             =   120
  67.       Width           =   564
  68.    End
  69. End
  70.  
  71. Option Explicit
  72.  
  73.  
  74.     ' Create form level globals?
  75.     Dim nCurrentYear As Integer
  76.     Dim nCurrentMonth As Integer
  77.     Dim nCurrentDay As Integer
  78.     Dim nStartDay As Integer
  79.     Dim nTotalDays As Integer
  80.     Dim nBlockNdx As Integer
  81.     Dim nCopyBlockNdx As Integer
  82.     Dim nBlockHeight As Integer
  83.     Dim nWidth As Integer
  84.     Dim nHeight As Integer
  85.  
  86. Sub Form_Activate ()
  87.  
  88.     ' Initialize form level date variables.
  89.     ' -------------------------------------
  90.     If IsDate(gDate) Then
  91.         nCurrentYear = Year(gDate)
  92.         nCurrentMonth = Month(gDate)
  93.         nCurrentDay = Day(gDate)
  94.     Else
  95.         nCurrentYear = Year(Now)
  96.         nCurrentMonth = Month(Now)
  97.         nCurrentDay = Day(Now)
  98.     End If
  99.  
  100.  
  101.     ' print days of the month.
  102.     ' ------------------------
  103.     PrintMonth
  104.  
  105. End Sub
  106.  
  107. '================================================
  108. ' = Get all the static non-moving bits out here =
  109. '================================================
  110. Sub Form_Load ()
  111.     
  112.     Dim i As Integer
  113.     Dim nOldWidth As Integer
  114.  
  115.     ' Set width/height of one char.
  116.     ' -----------------------------
  117.     nWidth = TextWidth("M") ' Change this for bigger/smaller calendars.
  118.     nHeight = nWidth * 1.9
  119.     
  120.  
  121.     ' resize the form.
  122.     ' ----------------
  123.     Me.Height = (nHeight * 6) + (nHeight * .75)
  124.     Me.Width = ((nWidth * 2) * 7) + (nWidth * 1.25)
  125.  
  126.     ' position left/right arrows.
  127.     ' ---------------------------
  128.     gpMonthSpin(1).Top = nHeight / 4
  129.     gpMonthSpin(2).Top = nHeight / 4
  130.     gpMonthSpin(1).Left = nWidth / 2
  131.     gpMonthSpin(2).Left = Width - gpMonthSpin(1).Width - (nWidth / 2)
  132.  
  133.     ' position month label between l/r arrows.
  134.     ' ----------------------------------------
  135.     lblMonthText.Top = nHeight / 4
  136.     lblMonthText.Left = gpMonthSpin(1).Left + gpMonthSpin(1).Width
  137.     lblMonthText.Width = gpMonthSpin(2).Left - lblMonthText.Left
  138.  
  139.     ' size background panel.
  140.     ' ----------------------
  141.     pic.Top = (nHeight * 2.25)
  142.     pic.Left = (nWidth / 2)
  143.     pic.Width = ((nWidth * 2) * 7) + 20
  144.     pic.Height = (nHeight * 4) + 50
  145.     
  146.     ' Output Day text.
  147.     ' ----------------
  148.     For i = 1 To 7
  149.         CurrentY = nHeight * 1.25
  150.         CurrentX = (i * (nWidth * 2)) - (nWidth * 1.5)
  151.         Print Mid$("SuMoTuWeThFrSa", i * 2 - 1, 2)
  152.     Next
  153.  
  154.     ' draw separator line + shadow.
  155.     ' -----------------------------
  156.     Line (0, nHeight * 2)-(Width, nHeight * 2), QBColor(0)
  157.     Line (0, nHeight * 2 + (nHeight / 29))-(Width, nHeight * 2 + (nHeight / 29)), QBColor(15)
  158.  
  159.     ' Attempt at a 3D border.
  160.     ' -----------------------
  161.     nOldWidth = Me.DrawWidth
  162.     Me.DrawWidth = 10
  163.     Me.Line (-30, -30)-Step(Me.Width + 50, 0), QBColor(15)
  164.     Me.Line -Step(0, Me.Height + 40), QBColor(8)
  165.     Me.Line -Step(-(Me.Width + 50), 0), QBColor(8)
  166.     Me.Line -Step(0, -(Me.Height + 40)), QBColor(15)
  167.     Me.DrawWidth = nOldWidth
  168.  
  169. End Sub
  170.  
  171. ' =============================================================
  172. ' Name.........: GetNumDaysInMonth(nYear, nMonth)
  173. ' Description..: Computes the number of days in any given month
  174. ' Parameters...: <nYear>  - needed to check for leap years
  175. '                <nMonth> - the month number (1-12)
  176. ' Returns......: An integer representing the days in the month
  177. ' =============================================================
  178. Function GetNumDaysInMonth (nYear As Integer, nMonth As Integer) As Integer
  179.    
  180.     Dim cMonth As String, nDays As Integer
  181.  
  182.     cMonth = "312831303130313130313031"
  183.  
  184.     ' Set defaults.
  185.     ' -------------
  186.     If nYear < 100 Or nYear > 9999 Then nYear = Year(Now)
  187.     If nMonth < 1 Or nMonth > 12 Then nMonth = Month(Now)
  188.  
  189.     ' Set the number of days in the requested month.
  190.     ' ----------------------------------------------
  191.     nDays = Val(Mid$(cMonth, nMonth * 2 - 2 + 1, 2))
  192.  
  193.     ' Compensate if requested year is a leap year, and month is February.
  194.     ' -------------------------------------------------------------------
  195.     If IsLeapYear(nYear) And nMonth = 2 Then nDays = nDays + 1
  196.    
  197.     GetNumDaysInMonth = nDays
  198.  
  199. End Function
  200.  
  201. Sub gpMonthSpin_MouseDown (Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  202.  
  203.     gpMonthSpin(Index).PictureDnChange = 2
  204.     
  205.     TmrMonthSpin.Interval = 500
  206.     TmrMonthSpin.Enabled = True
  207.     TmrMonthSpin.Tag = Choose(Index, -1, 1)
  208.     nCurrentMonth = nCurrentMonth + TmrMonthSpin.Tag
  209.     PrintMonthText
  210.  
  211. End Sub
  212.  
  213. Sub gpMonthSpin_MouseUp (Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  214.  
  215.     gpMonthSpin(Index).PictureDnChange = 0
  216.  
  217.     ' turn off timer
  218.     TmrMonthSpin.Enabled = False
  219.     PrintMonth
  220.  
  221. End Sub
  222.  
  223. ' =============================================================
  224. ' Name.........: IsLeapYear( nYear )
  225. ' Description..:  Determines if a year is a leap year, or not.
  226. ' Parameters...: <nYear>  -
  227. ' Returns......: An integer (boolean). True = it is a leap year
  228. ' =============================================================
  229. Function IsLeapYear (nYear)
  230.    
  231.    ' If the year is evenly divisible by 4 and not divisible
  232.    ' by 100, or if the year is evenly divisible by 400, then
  233.    ' it's a leap year.
  234.  
  235.    IsLeapYear = (nYear Mod 4 = 0 And nYear Mod 100 <> 0) Or (nYear Mod 400 = 0)
  236.  
  237. End Function
  238.  
  239. Sub pic_Click ()
  240.  
  241.     ' Return to 'sub-level' code.
  242.     ' ---------------------------
  243.     If nCurrentDay > 0 Then
  244.         gDate = DateSerial(nCurrentYear, nCurrentMonth, nCurrentDay)
  245.         Me.Hide
  246.     End If
  247.  
  248. End Sub
  249.  
  250. Sub pic_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
  251.  
  252.     ' Just pass it along to "MouseMove".
  253.     ' ----------------------------------
  254.     pic_MouseMove Button, Shift, x, y
  255.  
  256. End Sub
  257.  
  258. Sub pic_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
  259.     
  260.     Dim i  As Integer
  261.     Dim xt As Integer, x1 As Integer, x2 As Integer
  262.     Dim yt As Integer, y1 As Integer, y2 As Integer
  263.  
  264.     ' OK. The mouse is moving over the picture. Do we care?
  265.     ' Only if the left mouse button is pressed.
  266.     ' We then